unit uDZDataSetSerializer;

interface

uses
  Classes, Windows, DB, Variants, uDZSysUtils, uDZSerializer;

type
  TDzDatasetClassReader = class(TDzClassReader)
  private
    fDataSet: TDataSet;
    fFieldName: WideString;
    function FindField(const Name: TNameString): TField;
  public
    constructor Create; overload; override;
    constructor Create(DS: TDataSet); reintroduce; overload;
    function BeginReadRootObject(out ClsName: TNameString): Boolean; override;
    function BeginReadObject(const Name: TNameString): Boolean; override;
    procedure EndReadObject; override;
    function BeginReadList(out Count: Integer): Boolean; override;
    procedure EndReadList; override;
    function BeginReadListItem(Index: Integer): Boolean; override;
    function EndReadListItem: Boolean; override;
    procedure ReadPropList(props: TStrings); override;
    function ReadAnsiChar(const Name: TNameString; out Value: AnsiChar): Boolean; override;
    function ReadWideChar(const Name: TNameString; out Value: WideChar): Boolean; override;
    function ReadDWord(const Name: TNameString; out Value: Integer): Boolean; override;
    function ReadQWord(const Name: TNameString; out Value: Int64): Boolean; override;
    function ReadFloat(const Name: TNameString; out Value: Extended): Boolean; override;

    function ReadAnsiStr(const Name: TNameString;
      out Value: AnsiString): Boolean; override;

    function ReadWideStr(const Name: TNameString;
      out Value: WideString): Boolean; override;

    function ReadUnicodeStr(const Name: TNameString;
      out Value: WideString): Boolean; override;

    function ReadAnsiStrListItem(Index: Integer; out Value: AnsiString;
      out More: Boolean): Boolean; override;

    function ReadWStrListItem(Index: Integer; out Value: WideString;
      out More: Boolean): Boolean; override;

    function ReadUStrListItem(Index: Integer; out Value: WideString;
      out More: Boolean): Boolean; override;

    property DataSet: TDataSet read fDataSet write fDataSet;
  end;
  
implementation

{ TDzDatasetClassReader }

function TDzDatasetClassReader.BeginReadList(out Count: Integer): Boolean;
begin
  Count := fDataSet.RecordCount;
  Result := True;
end;

function TDzDatasetClassReader.BeginReadListItem(Index: Integer): Boolean;
begin
  Result := True;
end;

function TDzDatasetClassReader.BeginReadObject(const Name: TNameString): Boolean;
begin
  Result := True;
end;

function TDzDatasetClassReader.BeginReadRootObject(out ClsName: TNameString): Boolean;
begin
  Result := True;
end;

constructor TDzDatasetClassReader.Create(DS: TDataSet);
begin
  Create;
  fDataSet := DS;
end;

constructor TDzDatasetClassReader.Create;
begin
  inherited;
  SetLength(fFieldName, 256);
end;

procedure TDzDatasetClassReader.EndReadList;
begin

end;

function TDzDatasetClassReader.EndReadListItem: Boolean;
begin
  Result := True;
end;

procedure TDzDatasetClassReader.EndReadObject;
begin

end;

function TDzDatasetClassReader.FindField(const Name: TNameString): TField;
var
  i: Integer;
  fld: TField;
begin
  for i := 1 to Length(Name) do
    fFieldName[i] := WideChar(Name[i]);
  for i := Length(Name) + 1 to Length(fFieldName) do
    fFieldName[i] := #0; 
  fld := fDataSet.FindField(fFieldName);
  if (fld <> nil) and (not fld.IsNull) then Result := fld
  else Result := nil;
end;

function TDzDatasetClassReader.ReadAnsiChar(const Name: TNameString;
  out Value: AnsiChar): Boolean;
var
  fld: TField;
begin
  fld := FindField(Name);
  if ((fld = nil) or not (fld.DataType in [ftFixedChar
    {$ifdef delphi2006_or_higher}, ftFixedWideChar{$endif}]) or
    (fld.IsNull)) then Result := False
  else begin
    Value := fld.AsString[1];     
    Result := True;
  end;
end;

function TDzDatasetClassReader.ReadAnsiStrListItem(Index: Integer;
  out Value: AnsiString; out More: Boolean): Boolean;
begin
  Result := False;
end;

function TDzDatasetClassReader.ReadAnsiStr(const Name: TNameString;
  out Value: AnsiString): Boolean;
var
  fld: TField;
begin
  fld := FindField(Name);
  if ((fld = nil) or (fld.IsNull)) then Result := False
  else begin
    Result := True;
    case fld.DataType of
      {$ifdef delphi2006_or_higher}
      ftWideString, ftFixedWideChar: Value := fld.AsWideString;
      {$else}
      ftWideString: Value := fld.AsString;
      {$endif}
      ftString, ftFixedChar, ftMemo: Value := fld.AsString;
      else Result := False;
    end;
  end;
end;

function TDzDatasetClassReader.ReadFloat(const Name: TNameString;
  out Value: Extended): Boolean;
var
  fld: TField;
begin
  fld := FindField(Name);
  if ((fld = nil) or (fld.IsNull)) then Result := False
  else begin
    Value := fld.AsFloat;
    Result := True;
  end;
end;

function TDzDatasetClassReader.ReadQWord(const Name: TNameString;
  out Value: Int64): Boolean;
var
  fld: TField;
begin
  fld := FindField(Name);
  if ((fld = nil) or (fld.IsNull)) then Result := False
  else begin
    try
      if (fld is TLargeintField) then
        Value := TLargeintField(fld).AsLargeInt
      else
        Value := fld.AsInteger;
    except
      Value := 0;
    end;
    Result := True;
  end;
end;

function TDzDatasetClassReader.ReadDWord(const Name: TNameString;
  out Value: Integer): Boolean;
var
  fld: TField;
begin
  fld := FindField(Name);
  if ((fld = nil) or (fld.IsNull)) then Result := False
  else begin
    try
      Value := fld.AsInteger;
    except
      Value := 0;
    end;
    Result := True;
  end;
end;

procedure TDzDatasetClassReader.ReadPropList(props: TStrings);
begin

end;

function TDzDatasetClassReader.ReadUStrListItem(Index: Integer;
  out Value: WideString; out More: Boolean): Boolean;
begin
  Result := False;
end;

function TDzDatasetClassReader.ReadUnicodeStr(const Name: TNameString;
  out Value: WideString): Boolean;
var
  fld: TField;
begin
  fld := FindField(Name);
  if ((fld = nil) or (fld.IsNull)) then Result := False
  else begin
    Result := True;
    case fld.DataType of
      {$ifdef delphi2006_or_higher}
      ftWideString, ftFixedWideChar: Value := fld.AsWideString;
      {$else}
      ftWideString: Value := fld.AsVariant;
      {$endif}
      ftString, ftFixedChar: Value := fld.AsString;
      else Result := False;
    end;
  end;
end;

function TDzDatasetClassReader.ReadWideChar(const Name: TNameString;
  out Value: WideChar): Boolean;
var
  fld: TField;
begin
  fld := FindField(Name);
  if ((fld = nil) or not (fld.DataType in [ftFixedChar
    {$ifdef delphi2006_or_higher}, ftFixedWideChar{$endif}]) or
    (fld.IsNull)) then Result := False
  else begin
    {$ifdef delphi2006_or_higher}
    Value := fld.AsWideString[1];
    {$else}
    Value := VarToWideStr(fld.AsVariant)[1];
    {$endif}
    Result := True;
  end;
end;

function TDzDatasetClassReader.ReadWStrListItem(Index: Integer;
  out Value: WideString; out More: Boolean): Boolean;
begin
  Result := False;
end;

function TDzDatasetClassReader.ReadWideStr(const Name: TNameString;
  out Value: WideString): Boolean;
var
  fld: TField;
begin
  fld := FindField(Name);
  if ((fld = nil) or (fld.IsNull)) then Result := False
  else begin
    Result := True;
    case fld.DataType of
      {$ifdef delphi2006_or_higher}
      ftWideString, ftFixedWideChar: Value := fld.AsWideString;
      {$else}
      ftWideString: Value := VarToWideStr(fld.AsVariant);
      {$endif}
      ftString, ftFixedChar: Value := fld.AsString;
      else Result := False;
    end;
  end;
end;

end.
